home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue53 / construc / WEBMOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1999-12-06  |  3.8 KB  |  144 lines
  1. unit WebMod;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, HTTPApp, MidItems, QueryComps,
  5.   CompProd, PagItems, MidProd, DrBob42X;
  6.  
  7. type
  8.   TWebModule1 = class(TWebModule)
  9.     MidasPageProducer1: TMidasPageProducer;
  10.     QueryForm1: TQueryForm;
  11.     QueryButtons1: TQueryButtons;
  12.     QueryFieldGroup1: TQueryFieldGroup;
  13.     QuerySelectOptions: TQuerySelectOptions;
  14.     QueryPassword: TQueryPassword;
  15.     QueryCheckbox: TQueryCheckbox;
  16.     PageProducer1: TPageProducer;
  17.     procedure WebModule1WebActionItem1Action(Sender: TObject;
  18.       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  19.     procedure WebModule1WebActionItem2Action(Sender: TObject;
  20.       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  21.     procedure WebModule1WebActionItem3Action(Sender: TObject;
  22.       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  23.     procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  24.       const TagString: String; TagParams: TStrings;
  25.       var ReplaceText: String);
  26.   private
  27.     { Private declarations }
  28.     procedure AddLogEntry(Message: String);
  29.     function LogEntries: String;
  30.   public
  31.     { Public declarations }
  32.   end;
  33.  
  34. var
  35.   WebModule1: TWebModule1;
  36.  
  37. implementation
  38. {$R *.DFM}
  39.  
  40. const
  41.   LogFile = 'c:\logfile.txt';
  42.  
  43. procedure TWebModule1.AddLogEntry(Message: String);
  44. var
  45.   f: System.Text;
  46. begin
  47.   System.Assign(f,LogFile);
  48.   Append(f);
  49.   // start with empty file, in order to be able to append
  50.   writeln(f,Message);
  51.   Close(f)
  52. end;
  53.  
  54. function TWebModule1.LogEntries: String;
  55. var
  56.   f: System.Text;
  57.   Str: String;
  58. begin
  59.   Result := '<PRE>';
  60.   System.Assign(f,LogFile);
  61.   Reset(f);
  62.   while not eof(f) do
  63.   begin
  64.     readln(f,Str);
  65.     Result := Result + Str
  66.   end;
  67.   Close(f);
  68.   Result := Result + '</PRE>'
  69. end;
  70.  
  71. procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  72.   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  73. var
  74.   FileStream: TFileStream;
  75. begin
  76.   try
  77.     FileStream := TFileStream.Create('d:\www\drbob42\gif\javahelp.gif',
  78.       fmOpenRead OR fmShareDenyNone);
  79.     try
  80.       FileStream.Position := 0;
  81.       Response.ContentType := 'image/gif';
  82.       Response.ContentStream := FileStream;
  83.       Response.SendResponse; // send header + Stream
  84.       AddLogEntry('d:\www\drbob42\gif\javahelp.gif shown')
  85.     finally
  86.       FileStream.Free
  87.     end
  88.   except
  89.   end
  90. end;
  91.  
  92. procedure TWebModule1.WebModule1WebActionItem2Action(Sender: TObject;
  93.   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  94. const
  95.   MaxBanners = 4;
  96.   Banners: Array[0..MaxBanners-1] of String =
  97.     ('d:\www\drbob42\gif\robohlp1.gif',
  98.      'd:\www\drbob42\gif\robohlp2.gif',
  99.      'd:\www\drbob42\gif\robohlp3.gif',
  100.      'd:\www\drbob42\gif\robohlp4.gif');
  101. var
  102.   FileStream: TFileStream;
  103.   Banner: Integer;
  104. begin
  105.   try
  106.     Banner := Random(MaxBanners);
  107.     FileStream := TFileStream.Create(
  108.       Banners[Banner],
  109.       fmOpenRead OR fmShareDenyNone);
  110.     try
  111.       FileStream.Position := 0;
  112.       Response.ContentType := 'image/gif';
  113.       Response.ContentStream := FileStream;
  114.       Response.SendResponse; // send header + Stream
  115.       AddLogEntry(Banners[Banner]+' shown (random)')
  116.     finally
  117.       FileStream.Free
  118.     end
  119.   except
  120.   end
  121. end;
  122.  
  123. procedure TWebModule1.WebModule1WebActionItem3Action(Sender: TObject;
  124.   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  125. var
  126.   URL: String;
  127. begin
  128.   URL := Request.QueryFields.Values['URL'];
  129.   Response.SendRedirect(URL);
  130.   AddLogEntry('Redirection to '+URL)
  131. end;
  132.  
  133. procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  134.   const TagString: String; TagParams: TStrings; var ReplaceText: String);
  135. begin
  136.   if TagString = 'REPORT' then
  137.     ReplaceText := LogEntries
  138. end;
  139.  
  140. initialization
  141.   Randomize;  
  142. end.
  143.  
  144.